1000 ; 1010 ;FUNCTION WEDGE 1020 ;BY FRANK E. DIGIOIA 1030 ;11/12/85 1040 ; 1050 * = $C000 ;CONVENIENT START 1060 ; 1070 CHRGET = $0073 ;GET BYTE OF TEXT 1080 CHR(null)T = $0079 ;GET SAME BYTE 1090 IEVAL = $030A ;EVALUATION VECTOR 1100 TYPE = $0D ;TYPE FLAG 1110 ; 1120 INIT = * ;INITIALIZE ROUTINE 1130 LDA #FWEDGE 1160 STA IEVAL+1 1170 RTS 1180 ; 1190 FWEDGE = * ;THIS IS THE WEDGE 1200 LDA #$00 ;FLAG FOR NUMERIC 1210 STA TYPE ;SET TYPE FLAG 1220 ; 1230 JSR CHRGET ;SEE WHAT WE'VE (null)T 1240 CMP #'$' ;HEX CONVERSIONPRINT 1250 BEQ JUMP 1260 CMP #'%' ;BINARY CONVERSIONPRINT 1270 BEQ JUMP+3 1280 CMP #'@' ;PLOT FUNCTIONPRINT 1290 BEQ JUMP+6 1300 CMP #'#' ;THE # COMMANDPRINT 1310 BEQ JUMP+9 1320 CMP #'!' ;USE THE PARSERPRINT 1330 BEQ PARSER 1340 ;NOT ONE OF OURS 1350 JSR CHR(null)T ;SET FLAGS AGAIN 1360 JMP $AE8D ;USE ORIGINAL ROUTINE 1370 ; 1380 JUMP = * ;JUMP TABLE FOR FNS 1390 JMP HEX 1400 JMP BIN 1410 JMP XPLOT 1420 JMP EXPAND 1430 ; 1440 PARSER = * ;PARSE & EXECUTE 1450 LDA #$00 ;CLEAR ALL REGS 1460 STA COUNT ;AND COUNTER 1470 TAX 1480 TAY 1490 ; 1500 PLOOP INY ;INCR TEXT INDEX 1510 LDA TABLE,X ;GET TABLE BYTE 1520 BEQ ERROR ;END OF TABLE 1530 INX ;INCR TABLE POINTER 1540 CMP ($7A),Y ;CMPARE WITH TEXT 1550 BNE NEXT ;FIND NEXT WORD 1560 BEQ PLOOP ;MATCH/KEEP LOOKING 1570 ; 1580 NEXT DEX ;BUMP .X DOWN ONCE 1590 LDA TABLE,X ;END OF TABLE WORDPRINT 1600 BPL FIND ;NO/FIND END OF WORD 1610 AND #$7F ;YES/MASK FLAG 1620 CMP ($7A),Y ;IS IT A MATCHPRINT 1630 BEQ FOUND ;HOORAY!!! 1640 BNE X1 ;(null) BACK FOR MORE 1650 ; 1660 FIND INX ;FIND END OF WORD 1670 LDA TABLE,X ;LOOK FOR NEGATIVE 1680 BEQ ERROR ;END OF TABLE 1690 BPL FIND ;KEEP LOOKING 1700 ; 1710 X1 INX ;POINT TO NEXT WORD 1720 INC COUNT ;WORD # IN TABLE 1730 LDY #$00 ;RESET TEXT INDEX 1740 JMP PLOOP ;SEARCH SOME MORE 1750 ; 1760 FOUND = * ;EXECUTION ROUTINE 1770 INY ;POINT TO NEXT BYTE 1780 TYA ;UPDATE TEXT POINTER 1790 CLC 1800 ADC $7A 1810 STA $7A 1820 BCC *+4 1830 INC $7B 1840 ; 1850 LDA COUNT ;GET OFFSET IN TABLE 1860 ASL A ;MULTIPLY BY TWO 1870 TAX ;USE AS INDEX 1880 LDA ADRTAB+1,X ;HI BYTE ADR 1890 PHA ;AS RETURN ADR HI 1900 LDA ADRTAB,X ;LO BYTE ADR 1910 PHA ;AS RETURN ADR LO 1920 RTS ;EXECUTE ROUTINE 1930 ; 1940 COUNT .BYTE $00 1950 ERROR JMP $AF08 ;SYNTAX ERROR 1960 ; 1970 ;DATA TABLES -- ADD YOUR OWN 1980 ;ROUTINE NAMES AND ADDRESSES 1990 ;HERE. BE SURE TO ADD $80 TO 2000 ;LAST CHARACTER OF NAME AND 2010 ;SUBTRACT 1 FROM THE ADDRESS 2020 ; 2030 TABLE .BYTE 'MO',$C4,'FRA',$C3 2040 .BYTE 'DI',$D6,'DSTA',$D4,$00 2050 ; 2060 ADRTAB .WORD MOD-1,FRAC-1,DIV-1,DSTAT-1 2070 ; 2080 ; 2090 ;FUNCTION CALCULATION ROUTINES 2100 ; 2110 ;DSTAT FUNCTION 2120 ; 2130 ACPTR = $FFA5 ;GET BYTE FROM SERIAL PORT 2140 FA = $BA ;DEVICE NUMBER 2150 SA = $B9 ;SECONDARY ADDRESS 2160 WBUF = $033C ;BUFFER FOR STRING 2170 TALK = $FFB4 ;TELL DEVICE TO TALK 2180 TKSA = $FF96 ;SEND 2ND ADR FOR TALK 2190 UNTALK = $FFAB ;FREE SERIAL BUS 2200 ; 2210 DSTAT = * 2220 LDX #$08 ;DEVICE NUMBER (DISK) 2230 STX FA ;FIRST ADDRESS 2240 TXA 2250 JSR TALK ;TELL DRIVE TO SPEAK 2260 LDA #$6F ;CHANNEL 15 (OR $60) 2270 STA SA ;SECONDARY ADDRESS 2280 JSR TKSA ;SEND IT TO DRIVE 2290 LDX #$00 2300 ; 2310 DLOOP = * ;READ COMMAND CHANNEL 2320 JSR ACPTR ;GET BYTE FROM DRIVE 2330 STA WBUF,X ;STORE CHARACTER 2340 INX 2350 CMP #$0D ;CARRIAGE RETURNPRINT 2360 BNE DLOOP 2370 JSR UNTALK ;FREE SERIAL PORT 2380 ; 2390 DEX ;FORGET THE 2400 TXA ;PUT LENGTH IN .A 2410 STA LEN ;SAVE IT 2420 JSR $B47D ;RESERVE SPACE FOR STRING 2430 LDY LEN ;USE LENGTH FOR INDEX 2440 ; 2450 DLOOP2 = * ;COPY STRING FOR BASIC 2460 LDA WBUF,Y ;GET BYTE OF STRING 2470 STA ($62),Y ;PUT IN STRING MEM. 2480 DEY ;BUMP POINTER DOWN 2490 BPL DLOOP2 2500 JMP $B4CA ;PUT DSCRPTR ON STACK 2510 ; 2520 ; 2530 ;@(ROW,COL) FUNCTION - PLOT 2540 ;CURSOR AND RETURN NULL STRING 2550 ; 2560 CHKLFT = $AEFA ;CHECK LEFT PAREN 2570 CHKRHT = $AEF7 ;CHECK RIGHT PAREN 2580 CHKCOM = $AEFD ;CHECK ON COMMA 2590 GETBYT = $B79E ;GET BYTE INTO .X 2600 PLOT = $FFF0 ;PLOT/FETCH CURSOR 2610 ; 2620 XPLOT = * 2630 JSR CHRGET ;GET NEXT BYTE 2640 JSR GETPRM ;GET ROW/COL IN X/Y 2650 CPX #$19 ;ROW LESS THAN 25PRINT 2660 BCC CHKY ;YES/CHECK COLUMN 2670 BAD JMP ILEGAL ;NO/ILLEGAL QUANT. 2680 CHKY CPY #$28 ;COL LESS THAN 40PRINT 2690 BCS BAD ;NO/TRASH IT. 2700 CLC ;JUST FOR LOOKS 2710 JSR PLOT ;PLOT THE CURSOR 2720 LDA #$00 ;SET LEN TO ZERO 2730 JSR $B47D ;RESERVE SPACE 2740 JMP $B4CA ;PUT DESCRPTR ON STACK 2750 ; 2760 GETPRM=*;GET (A,B) INTO .X/.Y 2770 JSR CHKLFT ;CHECK OPEN PAREN 2780 JSR GETBYT ;GET FIRST PARM 2790 STX LEN ;SAVE IT HERE 2800 JSR CHKCOM ;CHECK ON COMMA 2810 JSR GETBYT ;GET SECOND BYTE 2820 TXA ;PUT IN .A 2830 PHA ;KEEP IT SAFE 2840 JSR CHKRHT ;CHECK CLOSING PAREN 2850 PLA ;RETRIEVE 2ND PARM 2860 TAY ;PUT IN .Y 2870 LDX LEN ;RETRIEVE 1ST PARM 2880 RTS 2890 LEN .BYTE $00 2900 ; 2910 ; 2920 ;THE #(LO,HI) COMMAND -- CONVERT 2930 ;LO/HI TO 16 BIT NUMBER. 2940 ; 2950 EXPAND = * 2960 JSR CHRGET ;GET NEXT BYTE OF TEXT 2970 JSR GETPRM ;GET PARMS INTO X/Y 2980 STX $63 ;LO BYTE IN $63 2990 STY $62 ;HI BYTE IN $62 3000 LDX #$90 ;SET EXPONENT TO 15 3010 SEC ;DON'T INVERT MANTISSA 3020 JMP $BC49 ;CONVERT TO FAC 3030 ; 3040 ; 3050 ;HEX/BINARY CONVERSION ROUTINE -- 3060 ;THIS ROUTINE CONVERTS ASCII 3070 ;HEX OR BINARY NUMBERS TO FLOATING 3080 ;POINT. 3090 ; 3100 ADDBYT = $BD7E ;ADD .A TO FAC 3110 ILEGAL = $B248 ;ILLEGAL QUANTITY 3120 OFLOW = $B97E ;OVERFLOW ERROR 3130 EXP = $61 ;EXPONENT OF FAC 3140 ; 3150 HEX LDA #$00 ;FLAG FOR HEX 3160 .BYTE $2C ;SKIP NEXT INSTR. 3170 BIN LDA #$01 ;FLAG FOR BINARY 3180 STA FLAG ;SAVE FLAG 3190 JSR ZERO ;SET FAC TO ZERO 3200 ; 3210 LOOP JSR CHRGET ;GET NEXT CHAR. 3220 BEQ CDONE ;END OF STATEMENT 3230 JSR CONVRT ;CONVERT FROM ASCII 3240 JSR INCEXP ;INCR. FAC EXPONENT 3250 JSR ADDBYT ;ADD THE BYTE TO FAC 3260 JMP LOOP 3270 ; 3280 QUIT PLA ;PULL RETURN ADR. 3290 PLA 3300 CDONE JMP CHR(null)T ;SET FLAGS & RTS 3310 ; 3320 ;HEX/BIN SUBROUTINES 3330 ; 3340 ZERO = * ;SET FAC TO ZERO 3350 LDA #$00 ;HERE'S THE ZERO 3360 LDX #$05 ;5 BYTES + SIGN 3370 ; 3380 ZILCH STA EXP,X ;ZERO OUT BYTE 3390 DEX ;BUMP INDEX DOWN 3400 BPL ZILCH ;COUNTER ROLL OVERPRINT 3410 RTS 3420 ; 3430 CONVRT = * ;ASCII DIGIT TO TRUE VALUE 3440 BCC DIGIT ;CHRGET FLAG/DIGITPRINT 3450 LDX FLAG ;HEX OR BINARYPRINT 3460 BNE CHKERR ;BINARY NON-DIGIT 3470 CMP #'A' ;CHECK LOWER LIMIT 3480 BCC QUIT ;LESS THAN 'A' 3490 CMP #'G' ;CHECK UPPER LIMIT 3500 BCS CHKERR ;BIGGER THAN 'F' 3510 SEC 3520 SBC #$07 ;ACCOUNT FOR EXTRA 7 3530 DIGIT LDX FLAG ;HEX OR BINARYPRINT 3540 BEQ OKAY ;HEX/ANY DIGIT IS FINE 3550 CMP #'2' ;BIN/CHECK UPPER LIMIT 3560 BCS ERR2 ;BIGGER THAN 1 3570 OKAY SEC 3580 SBC #$30 ;CONVERT TO TRUE VALUE 3590 RTS 3600 ; 3610 CHKERR = * ;CHECK ILLEGAL QUANT. 3620 CMP #$41 ;COMPARE WITH 'A' 3630 BCC QUIT ;LESS THAN 'A' 3640 CMP #$5B ;COMPARE WITH '[' 3650 BCS QUIT ;GREATER THAN 'Z' 3660 ERR2 JMP ILEGAL ;ILLEGAL QUANTITY 3670 ; 3680 ; 3690 INCEXP = * ;INCREMENT EXPONENT 3700 LDX EXP ;GET EXPONENT 3710 BEQ EXIT ;FAC=0, DON'T INCR. 3720 PHA ;SAVE BYTE IN .A 3730 LDX FLAG ;USE FLAG FOR OFFSET 3740 LDA INCR,X ;GET INCR IN .A 3750 CLC 3760 ADC EXP ;ADD EXP TO INCR. 3770 BCS ERR1 ;OVERFLOW ERROR 3780 STA EXP ;UPDATE EXPONENT 3790 PLA ;RETRIEVE BYTE TO .A 3800 EXIT RTS 3810 ; 3820 ERR1 JMP OFLOW 3830 INCR .BYTE $04,$01 3840 FLAG .BYTE $00 3850 ; 3860 ; 3870 ;DIV/MOD/FRAC -- THESE ROUTINES RESPECTIVELY 3880 ;RETURN THE INTEGER-QUOTIENT, 3890 ;INTEGER-REMAINDER, OR FRACTIONAL 3900 ;PART OF THE QUOTIENT A/B. 3910 ; 3920 EXP = $61 ;ADR OF EXP OF FAC 3930 FACARG = $BC0C ;COPY FAC TO ARG 3940 FACMEM = $BBD4 ;STORE FAC AT ADR IN (X/Y) 3950 MDIV = $BB0F ;DIVIDE FAC BY MEM 3960 SUBTRT = $B853 ;SUBTRACT FAC FROM ARG 3970 MMULT = $BA28 ;MULT FAC BY MEM (A/Y) 3980 FACINT = $BCCC ;CONVERT FAC TO INTEGER 3990 ROUND = $BC1B ;ROUND THE FAC 4000 ADD5 = $B849 ;ADD .5 TO FAC 4010 FRMNUM = $AD8A ;GET NUMERIC PARM INTO FAC 4020 ; 4030 ; 4040 DIV = * ;ENTRY FOR DIV 4050 LDA #$00 ;FLAG FOR DIV 4060 .BYTE $2C ;SKIP NEXT INSTR 4070 MOD = * ;ENTRY FOR MOD 4080 LDA #$01 ;FLAG FOR MOD 4090 .BYTE $2C ;SKIP NEXT INSTR 4100 FRAC = * ;ENTRY FOR FRAC 4110 LDA #$FF ;FLAG FOR FRAC 4120 STA FLAG ;SET THE FLAG 4130 ; 4140 ;GET FIRST PARM IN FAC AND 2ND 4150 ;PARM IN ARG. 4160 ; 4170 JSR CHKLFT ;OPEN PARENPRINT 4180 JSR FRMNUM ;GET FIRST VALUE 4190 LDX #TEMP ;HI BYTE OF ADDRESS 4210 JSR FACMEM ;PLACE IN TEMP 4220 JSR CHKCOM ;COMMAPRINT 4230 JSR FRMNUM ;GET 2ND PARM 4240 JSR CHKRHT ;CLOSING PARENPRINT 4250 ; 4260 LDX #MODLUS ;IN .X/.Y 4280 JSR FACMEM ;STORE FAC AT MODLUS 4290 ; 4300 LDA #TEMP ;ADR OF 1ST PARM (HI) 4320 JSR MDIV ;FAC = TEMP/FAC 4330 JSR FACARG ;ARG = FAC 4340 JSR FACINT ;FAC = INT(FAC) 4350 ; 4360 ;CHECK FLAG. IF DIV FUNCTION 4370 ;THEN DONE, ELSE CONTINUE. 4380 ; 4390 LDA FLAG 4400 BEQ DONE 4410 ; 4420 LDA EXP ;MUST HAVE EXP IN .A 4430 JSR SUBTRT ;FAC = ARG - FAC 4440 ; 4450 ;CHECK FLAG. IF FRAC FUNCTION 4460 ;THEN DONE, ELSE CONTINUE. 4470 ; 4480 LDA FLAG 4490 BMI DONE 4500 ; 4510 LDA #MODLUS ;MODULUS IN .A/.Y 4530 JSR MMULT ;FAC = FAC * MODLUS 4540 JSR ADD5 ;ADD .5 FOR ROUNDOFF 4550 JSR FACINT ;TRUNCATE GARBAGE 4560 ; 4570 DONE JSR ROUND ;ROUND THE FAC 4580 RTS 4590 ; 4600 MODLUS * = *+5 4610 TEMP * = *+5 4620 ; 4630 .END